home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr09 / descendr.zip / DESCEND.BAS next >
BASIC Source File  |  1993-06-09  |  5KB  |  160 lines

  1. DECLARE SUB GetName (NAMERCD%, NAME$)
  2. PRINT "    ╔═══════════════════════════════════════════════════════╗ "
  3. PRINT "    ║                        DESCEND                        ║ "
  4. PRINT "    ║             Decendant Chart Generator                 ║ "
  5. PRINT "    ║          (C) Copyright 1989 by Kent Riggins           ║ "
  6. PRINT "    ╚═══════════════════════════════════════════════════════╝ "
  7.  
  8.  
  9. INPUT "     Enter path for input: ", fp$
  10. INPUT "     Enter path and file for output: ", outfile$
  11. '== Our Program Variables ===============================================
  12. DIM STACK%(1000), GenStack%(1000)
  13. fp$ = "C:\PAFDATA\"
  14.  
  15. Main:
  16. GOSUB OpenAllFiles
  17. GOSUB DescendentSearch
  18. GOSUB PrintFromWho
  19.  
  20. CLOSE ALL
  21. END
  22.  
  23. OpenAllFiles: '==========================================================
  24. OPEN outfile$ FOR OUTPUT AS #8
  25.  
  26. OPEN fp$ + "NAMADD2.DAT" FOR RANDOM AS #1 LEN = 224
  27.    FIELD 1, 41 AS AName$, 41 AS AAdd1$, 41 AS AAdd2$, 41 AS AAdd3$, 26 AS ATel$, 26 AS AStake$, 8 AS AStakenum$
  28. GET #1, (2)
  29. pname$ = LEFT$(AName$, (INSTR(AName$, CHR$(0)) - 1))
  30. padd1$ = LEFT$(AAdd1$, (INSTR(AAdd1$, CHR$(0)) - 1))
  31. padd2$ = LEFT$(AAdd2$, (INSTR(AAdd2$, CHR$(0)) - 1))
  32. padd3$ = LEFT$(AAdd3$, (INSTR(AAdd3$, CHR$(0)) - 1))
  33. ptel$ = LEFT$(ATel$, (INSTR(ATel$, CHR$(0)) - 1))
  34. pstake$ = LEFT$(AStake$, (INSTR(AStake$, CHR$(0)) - 1))
  35. pstakenum$ = LEFT$(AStakenum$, (INSTR(AStakenum$, CHR$(0)) - 1))
  36. CLOSE #1
  37.  
  38. OPEN fp$ + "NAME2.DAT" FOR RANDOM AS #1 LEN = 21
  39.    FIELD 1, 2 AS NLLINK$, 17 AS NNAME$, 2 AS NRLINK$
  40.  
  41.    FIELD 1, 11 AS NAMEMAX$, 10 AS NFIRSTDELET$
  42.  
  43. OPEN fp$ + "indiv2.dat" FOR RANDOM AS #2 LEN = 92
  44.    FIELD 2, 2 AS ISURNAME$, 2 AS IGIVEN1$, 2 AS IGIVEN2$, 2 AS IGIVEN3$, 2 AS ITITLE$, 1 AS ISEX$, 4 AS IBIRTHDT$, 2 AS IBPL1$, 2 AS IBPL2$, 2 AS IBPL3$, 2 AS IBPL4$, 4 AS ICHRISTDT$, 2 AS ICPL1$, 2 AS ICPL2$, 2 AS ICPL3$, 2 AS ICPL4$, 4 AS  _
  45. IDEATHDT$, 2 AS IDPL1$, 2 AS IDPL2$, 2 AS IDPL3$, 2 AS IDPL4$, 4 AS IBURIALDT$, 2 AS IBUPL1$, 2 AS IBUPL2$, 2 AS IBUPL3$, 2 AS IBUPL4$, 3 AS IBAPTDT$, 2 AS IBAPTEMP$, 3 AS IEDOWDT$, 2 AS IEDTEMP$, 3 AS ICHILDtoPARENTSealDT$, 2 AS ICTPSTEMP$, 2 AS  _
  46. IOlderSiblPtr$, 2 AS IndOwnMarrPtr$, 2 AS IParentMarrPtr$, 10 AS IIDNUM$, 2 AS INotePadPtr$
  47.  
  48.  
  49.     FIELD 2, 11 AS INDIVIDMAX$, 10 AS IFIRSTDELET$, 71 AS XXXX$
  50. GET #2, 1
  51. INDIVIDMAX% = VAL(INDIVIDMAX$)
  52.  
  53. OPEN fp$ + "MARR2.DAT" FOR RANDOM AS #3 LEN = 28
  54.     FIELD 3, 2 AS MHusPtr$, 2 AS MWifPtr$, 2 AS MChildPtr$, 4 AS MarrDT$, 2 AS MPL1$, 2 AS MPL2$, 2 AS MPL3$, 2 AS MPL4$, 3 AS MWifToHusSealDT$, 2 AS MWifToHusSealTemp$, 2 AS MHusOtherMarrPtr$, 2 AS MWifOtherMarrPtr$
  55.  
  56.  
  57.     FIELD 3, 11 AS MarrMAX$, 10 AS MarrFIRSTDELET$, 7 AS XXXX$
  58.  
  59. GET #3, 1
  60. MarrMAX% = VAL(MarrMAX$)
  61. RETURN
  62. PrintFromWho: '====================================================
  63. PRINT #8,
  64. PRINT #8,
  65. PRINT #8, pname$
  66. PRINT #8, padd1$
  67. PRINT #8, padd2$
  68. PRINT #8, padd3$
  69. PRINT #8, ptel$
  70. PRINT #8, pstake$
  71. PRINT #8, pstakenum$
  72.  
  73. RETURN
  74.  
  75. DescendentSearch:
  76. PTR = 0
  77. PRINT "Enter starting RIN: ";
  78. INPUT STRIN%
  79.  
  80. GEN% = 1
  81. PTR = PTR + 1: STACK%(PTR) = STRIN%: GenStack%(PTR) = GEN%
  82. Start:
  83.    IF PTR = 0 THEN GOTO FINISH
  84.    RIN% = STACK%(PTR)
  85.    GET #2, (RIN% + 1): GEN% = GenStack%(PTR): PTR = PTR - 1
  86.    GEN$ = STR$(GEN%) + "-"
  87.    GOSUB PrintIndividual
  88.  
  89.    IF CVI(IndOwnMarrPtr$) = 0 THEN GOTO Start
  90.    GET #3, (CVI(IndOwnMarrPtr$) + 1)
  91.    IF ISEX$ = "M" THEN
  92.       RIN% = CVI(MWifPtr$)
  93.       GET #2, (RIN% + 1)
  94.    ELSE
  95.       RIN% = CVI(MHusPtr$)
  96.       GET #2, (RIN% + 1)
  97.    END IF
  98.    GEN$ = " S-"
  99.    GOSUB PrintIndividual
  100.  
  101.    IF CVI(MChildPtr$) = 0 THEN GOTO Start
  102.    PTR = PTR + 1: STACK%(PTR) = CVI(MChildPtr$): GenStack%(PTR) = GEN% + 1
  103. StoreChildren:
  104.    GET #2, (STACK%(PTR) + 1)
  105.    IF CVI(IOlderSiblPtr$) = 0 THEN
  106.       GOTO Start
  107.    ELSE
  108.       PTR = PTR + 1: STACK%(PTR) = CVI(IOlderSiblPtr$): GenStack%(PTR) = GEN% + 1
  109.       GOTO StoreChildren
  110.    END IF
  111.  
  112.  
  113. FINISH:
  114.    RETURN
  115.  
  116. PrintIndividual:
  117. CALL GetName(CVI(ISURNAME$), SURname$)
  118. CALL GetName(CVI(IGIVEN1$), name1$)
  119. CALL GetName(CVI(IGIVEN2$), name2$)
  120. CALL GetName(CVI(IGIVEN3$), name3$)
  121. CALL GetName(CVI(ITITLE$), TITLE$)
  122. PRINT #8, SPACE$(GEN% * 2); GEN$; TITLE$; name1$; name2$; name3$; SURname$;
  123. PRINT #8, "(" + RIGHT$(STR$(RIN%), LEN(STR$(RIN%)) - 1) + ")"
  124.  
  125. RETURN
  126.  
  127.  
  128.  
  129. SUB ConvertDate (a$, YEAR%, MONTH%, DAY%, MODIFIER%, DYEAR%) STATIC'===============
  130.  
  131.     a1 = ASC(LEFT$(a$, 1))
  132.     a2 = ASC(MID$(a$, 2, 1))
  133.     a3 = ASC(MID$(a$, 3, 1))
  134.     a4 = ASC(MID$(a$, 4, 1))
  135.  
  136.     YEAR% = a1 * 16 + INT(a2 / 16)
  137.     MONTH% = (a2 - INT(a2 / 16) * 16) * 2 + INT(a3 / 128)
  138.     DAY% = INT((a3 - INT(a3 / 128) * 128) / 4)
  139.     MODIFIER% = a3 - INT(a3 / 4) * 4
  140.     IF a4 = 0 THEN
  141.        DYEAR% = 0
  142.     ELSE
  143.        DYEAR% = YEAR% + a4
  144.     END IF
  145. END SUB
  146.  
  147. SUB GetName (NAMERCD%, NAME$) STATIC'==========================================
  148.    SHARED NNAME$
  149.    IF NAMERCD% > 0 THEN
  150.       GET #1, (NAMERCD% + 1)
  151.       NAME$ = NNAME$
  152.       lg% = INSTR(NAME$, CHR$(0)) - 1
  153.       NAME$ = LEFT$(NAME$, lg%)
  154.       NAME$ = NAME$ + " "
  155.    ELSE
  156.       NAME$ = ""
  157.    END IF
  158. END SUB
  159.  
  160.